COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	begin "TEX" comment The TEX processor.
C00007 00003	Error handling procedures: quit,error,backerror,overflow,confusion
C00012 00004	Dynamic memory allocation: links, memsize, varsize, mem, memreal
C00015 00005	Partial field macros: field,ufield,link,info,setfield...setinfo
C00019 00006	Memory allocation procedures: getavail, freeavail, getnode, freenode
C00024 00007	Memory, continued: dslist,delrclink,delgluelink,checkmem,initmem
C00034 00008	Getting the whole thing started properly
C00039 ENDMK
C⊗;
begin "TEX" comment The TEX processor.

This processor is in five parts:

1. The present module contains routines for memory management,
	initialization, and external control (getting things
	started and stopped gracefully).
2. The TEXSYN module, compiled separately, contains routines 
	for scanning the input, including such things as the
	expansion of user-defined macros.
3. The TEXSEM module, compiled separately, contains routines
	for building the data structures corresponding to the
	user's source text.
4. The TEXOUT module, compiled separately, contains routines
	for outputting the data structures to a peripheral device.
	(Substitution of a different TEXOUT module will direct
	the output to a different device.)
5. The TEXEXT module, compiled separately, contains extensions
	that some users may decide to write in SAIL. In the
	initial implementation, only a dummy version of TEXEXT
	has been written, but calls to this module have been
	placed at critical points in the control structure.

There is an independently running program TEXPRE which does the preprocessing
necessary to compute the initial values of TEX's hash table, equivalents table,
and hyphenation tables, and which stores them on file TEXINI.TBL. The TEXPRE
program should be consulted for details about the initial contents of these
tables.

Finally, there is also a TEXHDR file which contains all the declarations of
variables used by more than one module.

It is wise to look at the first page of TEXHDR before reading the
following code, since TEXHDR introduces a few abbreviations that are
used throughout the TEX programs.

Historical notes: A prototype version of TEX was designed and coded by M. F. Plass
and F. M. Liang during the summer of 1977. The prototype included macro definitions
and elementary semantic manipulations on nodes and glue, but it did not have
paragraph justification, page building, mathematical formulas, alignment routines,
error recovery, or the present semantic nest. It used character lists instead of
token lists. Based on this experience, a complete version of TEX was designed and
coded by D. E. Knuth in late 1977 and early 1978, becoming operational in
March, 1978. The present code is the original March 1978 version with a few
minor changes;

require "TEXSYN.REL" load_module;
require "TEXSEM.REL" load_module;
require "TEXOUT.REL" load_module;
require "TEXEXT.REL" load_module;
require "TEXHDR.SAI" source_file;

comment To compile TEX with the BAIL debugger, make sure that DEBUGONLY
is defined to be ⊂⊃ in TEXHDR, then do "com texsyn(27b,)" and
"com texsem(27b,)" and "com texout(27b,)" and "com texext(27b,)" and "try texpre"
and finally "try texsys".
To compile TEX without BAIL, make sure that DEBUGONLY is defined to be
⊂comment⊃ in TEXHDR, then do "com texsyn"..."com texext" and "ex texpre" and
"ex texsys";
comment Error handling procedures: quit,error,backerror,overflow,confusion;

label end_of_TEX,final_end;
internal procedure quit # closes output files and terminates TEX;
begin integer c;
DEBUGONLY print(nextline,"Quitting; do you want a chance to see the memory?");
DEBUGONLY c←inchrw;
DEBUGONLY if c="y" then bail;
go to end_of_TEX;
end;

internal boolean pausing_on_errors # should TEX wait after error messages?;
internal boolean deletions_allowed # is it safe for error routine to call getnext?;

internal procedure error(string s) # prints an error message;
begin comment String s explains the type of error. This is displayed to the
user and then the current source code position is indicated;
print(nextline,"! ",s,".");
dumpcontext # prints indication of where the scanner is now;
if pausing_on_errors then while true do
	begin integer c;
	print("↑"); c←inchrw # wait for user to type a character;
	if c='15 then begin c←inchrw # ignore the line-feed; return end;
	if c='12 then begin pausing_on_errors←false; return end;
	if c>'140 then c←c-'40 # change lower case to upper case;
	if c="E" or c="T" then
		begin comment abort and enter the system editor;
		setprint(null,"N") # close the errors file;
		edfile(curfile,curfline,curfpage);
		end;
	if c="I" then
		begin pushinput;
		print(nextline,"*"); inbuf←inchwl # wait for user to type a line;
		curbuf←inbuf; state←midline; filename←null;
		return;
		end;
	if c="X" then go to end_of_TEX;
	if c≥"1" and c≤"9" and deletions_allowed then
		begin integer i; i←c-"0";
		while i>0 do
			begin getnext # recursive call shouldn't happen;
			i←i-1;
			end;
		dumpcontext # print new scanner status;
		continue;
		end;
	DEBUGONLY if c="B" then begin bail; return end;
	print(nextline,"Type <cr> to continue, <lf> to flash error messages,");
	if deletions_allowed then print(nextline,
		"	1 or ... or 9 to ignore the next 1 to 9 tokens of input,");
	print(nextline,"	i or I to insert something, e or E to edit,",
	" x or X to quit.",nextline);
	end;
end;

internal procedure backerror(string s) # error followed by backinput;
begin error(s);
backinput;
end;

procedure errorstop(string s) # prints message and dies;
begin pausing_on_errors←false;
error(s);
quit;
end;

internal procedure reportoverflow(string s; integer n)
	# for fatal errors when a TEX table is undersized;
errorstop("TEX capacity exceeded, sorry ["&s&"="&cvs(n)&"]");

internaldef overflow(s)=⊂reportoverflow("s",s)⊃ # specifies inadequate table size;
internal procedure memoverflow; overflow(memsize);

internal procedure confusion # TEX consistency check failure;
errorstop("This can't happen");

internal procedure mustquit # user input is really wild;
errorstop("All mixed up, can't continue");
comment Dynamic memory allocation: links, memsize, varsize, mem, memreal;

comment TEX does nearly all of its own memory allocation, so that it can
readily be transported into environments which do not have automatic
facilities for strings, garbage collection, etc. The dynamic storage
requirements of TEX are handled by providing a large integer array "mem" 
in which consecutive blocks of words are used as nodes by the TEX routines.
Pointer variables are indices into this array. To use mem[p] as a real
variable instead of as an integer, we write "memreal(p)".

The mem array is divided once and for all into two regions which are allocated
separately. The first varsize locations are used for storing variable-length
records consisting of two or more words. This region is maintained using an
algorithm similar to the one described in exercise 2.5-19 of ACP. However,
no size field appears in the allocated nodes: the program is responsible for
knowing the relevant size when the node is freed. Also, the sign in the first
word of each node is used as a boundary tag by the allocation routines, so
ALL DATA STRUCTURES MUST BE DESIGNED TO ENSURE THAT THE FIRST WORD OF
TWO-OR-MORE-WORD NODES IS NONNEGATIVE. The remaining region of mem is allocated
in single words using a conventional AVAIL stack.
;
internaldef links = 14 # number of bits per pointer;
internaldef memsize=8000 # size of dynamic list memory, must be ≤ 2↑links;
internaldef varsize=2500 # size of variable node memory, must be << memsize;
comment TEXHDR contains the true values of these volatile parameters;

preload_with 0 # the following array will be initialized upon loading;
internal integer array mem[0:memsize-1] # dynamic list memory;
internaldef memreal(p)=⊂memory[location(mem[p]),real]⊃ # mem[p] as type real;

DEBUGONLY internal integer dynused,varused # how much memory is in use;
comment Partial field macros: field,ufield,link,info,setfield...setinfo;

comment The following macros are for accessing and modifying partial fields
of packed words. If f is a field name, then fs denotes its size in bits
and fd denotes its displacement from the right of the word. These sizes and
displacements are defined at compile time--e.g.,"links" for size of link fields.
In the following definitions, x denotes the word being modified and y denotes
a new value to be inserted into the specified field (it must not be too
large for the field). The definitions look inefficient, but they take
advantage of the fact that SAIL does a lot of local optimization;


internaldef fs(f) = ⊂f⊃&"s" # field size of f, in bits;
internaldef fd(f) = ⊂f⊃&"d" # field displacement of f, in bits;

internaldef field(f,x) = ⊂ifc fd(f)=0 thenc ((x) land (2↑fs(f)-1))
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc ((x) lsh -fd(f))
	elsec (((x) lsh -fd(f)) land (2↑fs(f)-1)) endc endc⊃ # field f of x;

internaldef setfield(f,x,y) = ⊂ifc fd(f)=0 thenc x←(x land(-2↑fs(f)))+(y)
	elsec ifc fs(f)+fd(f)≥bitsperwd thenc 
		x←((x lsh(bitsperwd-fd(f)))+(y))rot fd(f)
	elsec x←(((x rot -fd(f))land(-2↑fs(f)))+(y))rot fd(f) endc endc⊃
		# sets field f of x equal to y, 0 ≤ y < 2↑fs(f);

comment Sometimes an unshifted field is desired. For this purpose, we use
ufield instead of field, and deal with values times 2↑fd;

internaldef ufield(f,x) = ⊂((x) land((1 lsh(fs(f)+fd(f)))-2↑fd(f)))⊃
		# unshifted field f of x;
internaldef setufield(f,x,y) = ⊂x←(x land lnot((1 lsh(fs(f)+fd(f)))-2↑fd(f)))+(y)⊃
		# field f of x set to unshifted value y;

comment The special case of a pointer field at the right of a word is
most common, so there are special conventions for it. When p is a pointer,
we write link(p) for the pointer field of mem[p] and info(p) for the
(shifted) remaining fields of the word;

internaldef linkd = 0 # displacement of link field;
internaldef link(p) = ⊂field(link,mem[p])⊃ # link field of mem[p];
internaldef setlink(p,y) = ⊂setfield(link,mem[p],y)⊃ # sets link(p)←y;
internaldef infod = links, infos = bitsperwd-infod # definition of info field;
internaldef info(p) = ⊂field(info,mem[p])⊃ # info field of mem[p];
internaldef setinfo(p,y) = ⊂setfield(info,mem[p],y)⊃ # sets info(p)←y;

DEBUGONLY integer procedure lk(integer x);
DEBUGONLY return(x land(2↑links-1)) # link field of packed word;
DEBUGONLY integer procedure fo(integer x);
DEBUGONLY return(x lsh -infod) # info field of packed word;
comment Memory allocation procedures: getavail, freeavail, getnode, freenode;

comment	getavail(p) makes p point to a new one-word node,
	freeavail(p) returns it to storage.
	p←getnode(s) makes p point to a new s-word node and clears mem[p] to zero,
	freenode(p,s) will return this node to storage.
;
internal integer avail # head of available space list for one-word nodes;
internaldef getavail(p) = ⊂begin if(p←avail)then avail←mem[avail]
	else memoverflow: DEBUGONLY dynused←dynused+1: end⊃ # p ← new node;
internaldef freeavail(p) = ⊂begin mem[p]←avail: avail←p:
	DEBUGONLY dynused←dynused-1: end⊃ # node p now available;

comment The available space list for variable-size nodes is a nonempty,
doubly-linked circular list, pointed to by the roving pointer "rover". 
The second word of each entry contains the size (which is always ≥2), while
the first word contains the llink and rlink and a minus sign;

integer rover # pointer into double-avail list;
define nodesize(p) = ⊂mem[p+1]⊃;
define llinks = links, llinkd = infod # definition of llink field;

internal integer procedure getnode(integer size) # variable-size node allocation;
begin comment returns a pointer to a new node of the specified size,
which must be 2 or more. All words of the new node are set to zero;
integer p,q,s,t,u;
label ovfl, found;
comment The following tricky code does
	llink(rlink(p))←llink(p), rlink(llink(p))←rlink(p);
define removenode(p)=
	⊂begin if p=rover then
		begin rover←link(p);
		if p=rover then go to ovfl # list musn't become empty;
		end;
	u←((p lsh llinkd) + p) xor mem[p] # bits to change;
	t←field(llink,mem[p]) # llink(p);
	mem[t]←field(link,u) xor mem[t];
	t←link(p) # rlink(p);
	mem[t]←ufield(llink,u) xor mem[t];
	end⊃;
p←rover;
do	begin q←p+nodesize(p) # q points past the end of node(p);
	while mem[q]<0 do
		begin comment merge with the next node, if it is free too;
		removenode(q); q←q+nodesize(q);
		end;
	if (s←q-p) ≥ size+2 then
		begin q←q-size # allocate from top end;
		nodesize(p)←q-p # remaining free area size;
		rover ← p # let rover rove around;
		go to found;
		end;
	if s = size then
		begin removenode(p) # exact fit, now t = rlink(p);
		rover ← t # let rover rove;
		q ← p; go to found;
		end;
	nodesize(p)←s # reset the node size in case it grew;
	p←link(p);
	end until p=rover # repeat until whole list traversed;
ovfl: overflow(varsize) # no large enough space was found;
found: for p ← q thru q+size-1 do mem[p]←0 # clear out the node found;
DEBUGONLY varused←varused+size;
return(q) # deliver the goods;
end;

internal procedure freenode(integer p,size) # variable-size node liberation;
begin comment The node of length "size" starting at mem[p] is made available
to the variable-node storage pool, by inserting it into the double-avail
list just before where rover now points. We must have size ≥ 2;
integer q;
q←field(llink,mem[rover]) # llink(rover);
setlink(q,p); setfield(llink,mem[rover],p);
mem[p]←(q lsh llinkd)+rover+(1 lsh(bitsperwd-1)) # now p is linked into the circle;
DEBUGONLY varused←varused-size;
nodesize(p)←size;
end;
comment Memory, continued: dslist,delrclink,delgluelink,checkmem,initmem;

internal procedure dslist(integer p) # makes list of 1-word nodes available;
begin comment The linked list of single-word nodes pointed to by p is freed;
integer q;
while p do
	begin q←link(p); freeavail(p); p←q;
	end;
end;

internaldef refct1 = 1 lsh infod # 1 in the information (reference count) field;

internal simple procedure delrclink(integer p) # remove ptr to list with ref ct;
begin comment info(p) is a reference count which is to be decreased by 1.
If the result is negative, the linked list of single-word nodes pointed to by p
is freed;
if(mem[p]←mem[p]-refct1)<0 then dslist(p);
end;

internal simple procedure delgluelink(integer p) # remove pointer to glue node;
begin comment info(p) is a reference count which is to be decreased by 1.
If the result is negative, node(p) (which has "gluespecsize" words) is freed;
if(mem[p]←mem[p]-refct1)<0 then freenode(p,gluespecsize);
comment In this case it's OK to let the first word of the node go negative;
end;

DEBUGONLY preload_with 0; DEBUGONLY integer array free[0:memsize-1];
DEBUGONLY internal procedure checkmem(boolean printlocs) # checks links in mem;
DEBUGONLY begin comment This procedure checks the format of the available space
DEBUGONLY lists and (if printlocs is true) prints those locations of mem that were
DEBUGONLY free the last time this procedure was called but reserved now.
DEBUGONLY All nodes should be returned to the avail lists when TEX is done with
DEBUGONLY them, and checkmem can be used to check if this has been done correctly;
DEBUGONLY integer p,i; label checksign;
DEBUGONLY p←avail;
DEBUGONLY while p do
DEBUGONLY 	begin if (free[p] land 1) or mem[p]≥memsize or
DEBUGONLY		(mem[p]≠0 and mem[p]≤varsize) then
DEBUGONLY 		begin print(nextline,"avail list clobbered at ",p);
DEBUGONLY		bail;done;
DEBUGONLY 		end;
DEBUGONLY 	free[p]←free[p] lor 1;
DEBUGONLY 	p←mem[p];
DEBUGONLY 	end;
DEBUGONLY p←rover;
DEBUGONLY do	begin
DEBUGONLY 	if p≥varsize or p≤0 or mem[p]≥0 or p+nodesize(p)>varsize or
DEBUGONLY 	nodesize(p)<2 or field(llink,mem[link(p)])≠p then
DEBUGONLY 		begin print(nextline,"double-avail list clobbered at ",p);
DEBUGONLY		bail;done;
DEBUGONLY 		end;
DEBUGONLY 	for i←p thru p+nodesize(p)-1 do
DEBUGONLY 		begin if free[i] land 1 then
DEBUGONLY 			begin print(nextline,"doubly free location at ",i);
DEBUGONLY 			bail;go to checksign;
DEBUGONLY 			end;
DEBUGONLY 		free[i]←free[i] lor 1;
DEBUGONLY 		end;
DEBUGONLY 	p←link(p);
DEBUGONLY 	end until p=rover;
DEBUGONLY checksign: i←0; while i< varsize do
DEBUGONLY	begin if mem[i]<0 then
DEBUGONLY		begin print(nextline,"node ",i,"starts negative");bail;
DEBUGONLY		end;
DEBUGONLY	while i<varsize and (free[i] land 1)=0 do i←i+1;
DEBUGONLY	while i<varsize and (free[i] land 1)≠0 do i←i+1;
DEBUGONLY	end;
DEBUGONLY if printlocs then print(nextline,"New busy locs: ");
DEBUGONLY for i←0 thru memsize-1 do
DEBUGONLY 	begin if free[i] land 3 = 2 and printlocs then print(i," ");
DEBUGONLY 	free[i]←free[i] lsh 1;
DEBUGONLY 	end;
DEBUGONLY end;

DEBUGONLY procedure searchmem(integer p) # finds pointers to p;
DEBUGONLY begin integer i;
DEBUGONLY for i←0 thru memsize-1 do
DEBUGONLY 	begin if link(i)=p then print(nextline,"link(",i,")");
DEBUGONLY 	if value(i)=p then print(nextline,"value(",i,")");
DEBUGONLY 	end;
DEBUGONLY for i←0 thru hashsize+127 do if field(link,eqtb[i])=p then
DEBUGONLY	print(nextline,"link in eqtb[",i,"]");
DEBUGONLY end;

comment Some areas of mem are dedicated to fixed usage. For example, the
list heads "pagehead" and "pagecontrib" of the page builder are assigned
to fixed memory locations. (Since mem[pagecontrib] will never be
negative, we define pagecontrib=varsize, then the getfree procedure will
never try to combine the one-word memory with a variable-size free node.)
The special glue used in \hfill and \vfill is kept in a fixed place, as
are the heads of alignrecord lists. Only locations mem[firstmem] thru
mem[varsize-1] are actually allocatable for variable-size memory, 
and mem[secondmem] thru mem[memsize-1] for one-word memory.
;
internaldef fillglue=0 # location of glue specification 0pt plus 10↑10 pt;
internaldef lowerfillglue=gluespecsize # loc of glue specification
		0pt plus 10↑6pt minus 10↑6 pt;
internaldef zeroglue=lowerfillglue+gluespecsize # loc of glue specification 0pt;
internaldef firstmem=zeroglue+gluespecsize # location of 
		first usable mem word, must be >0;
internaldef waitinghead=varsize # head of list of inserts too big for current page;
internaldef contribhead=waitinghead+1 # head of contribution vlist for current page;
internaldef pagehead=pagecontrib+1 # head of vlist for current page;
internaldef temphead=pagehead+1 # temporary head of a miscellaneous list;
internaldef holdhead=temphead+1 # temporary head of another miscellaneous list;
internaldef alignhead=holdhead+1 # alignhead+j is head of jth alignrecordlist;
internaldef inserts=alignhead+alignsize # head of insert list returned by packager;
internaldef hsizemem=inserts+1 # location where default hsize is stored;
internaldef vsizemem=hsizemem+1 # location where default vsize is stored;
internaldef maxdepthmem=vsizemem+1 # location where default maxdepth is stored;
internaldef parindentmem=maxdepthmem+1 # location where default parindent is stored;
internaldef topbaselinemem=parindentmem+1 # loc where default topbaseline is stored;
internaldef secondmem=topbaselinemem+1 # first usable mem word in 1-word area;

internal procedure initmem # initializes the memory system;
begin integer i;
for i←secondmem thru memsize-2 do mem[i+1]←i;
mem[secondmem]←0; avail←memsize-1 # now the avail stack is initialized;

mem[firstmem]←(firstmem lsh llinkd)+firstmem+(1 lsh(bitsperwd-1));
nodesize(firstmem)←varsize-firstmem # one node in the circle;
rover←firstmem # rover points to it, now the double-avail list is initialized;

for i←0 thru firstmem-1 do mem[i]←0;
for i←varsize thru secondmem-1 do mem[i]←0;
end;
comment Getting the whole thing started properly;

preload_with true; boolean array notalreadyinitialized[0:0];

comment The declarations have now ended, TEX starts here after being loaded;
if notalreadyinitialized[0] then
	begin integer chan;
	notalreadyinitialized[0]←false;
	initmem # initialize the mem array, this should be done first;
	gluestretch(fillglue)←10000000000.0 # initialize the fillglue;
	gluestretch(lowerfillglue)←glueshrink(lowerfillglue)←1000000.0;
	mem[zeroglue]←mem[lowerfillglue]←mem[fillglue]←
		1000000 lsh infod # "infinite" reference count;
	initsftable(3.0,3.0,3.0,2.0,1.5,1.25) # initialize the spacefactor table;

	open(chan←getchan,"DSK",'10,2,0,0,0,eof);
	lookup(chan,"TEXINI.TBL",eof);
	if eof or wordin(chan)≠hashsize or wordin(chan)≠eqtbsize or
		wordin(chan)≠locsize or
		wordin(chan)≠excepsize or wordin(chan)≠sufsize or
		wordin(chan)≠prefsize or wordin(chan)≠btabsize or
		wordin(chan)≠pagememsize then
		begin print("TEXINI.TBL is clobbered!"); go to final_end;
		comment If this error happens, execute TEXPRE to rewrite the file;
		end;
	arryin(chan,hash[0],hashsize);
	arryin(chan,eqtb[0],eqtbsize);
	arryin(chan,locs[0],locsize);
	arryin(chan,exceptable[0],excepsize);
	arryin(chan,excephyph[1],excepsize-1);
	arryin(chan,suffix[0],sufsize);
	arryin(chan,prefix[0],prefsize);
	arryin(chan,btable[2],btabsize);
	arryin(chan,pagemem[0],pagememsize);
	arryin(chan,delimtable[0],128);
	release(chan);

	pausing_on_errors←true; deletions_allowed←true;

	outstr("TEX's tables have been initialized. 
	Either hit CALL and .SAVE TEX for future RUNning,
	or type <cr> to go on.");
	if inchwl then;
	end;
initext # initialize the extensions if any;
initsave # initialize the save-restore mechanism;
setformat(0,4) # controls format of cvf in diagnostic routine "dumpnodelist";
setprint("errors.tmp","B") # printing goes to file as well as terminal;
DEBUGONLY dynused←varused←0;
initin # initialize the input system;
initout # initialize the output system;
fmemptr←0 # initialize the secondary font memory;
maincontrol # transfer power to the chief executive;

end_of_TEX: closeout # close output files of TEXOUT;
setprint("errors.tmp","N") # close print output file;
finishext # do any closing actions desired by extensions;
final_end: end "TEX"